Tech Arsenal 1/Tech Arsenal (Arsenal Computer).ISO/tek-19/quikcmd3.zip/BLOCKS.LSP

Lisp/Scheme | 1992-07-05 | 5.9 KB | 163 lines

;  BLOCKS.LSP
 ;
 ;                         QUICK COMMAND Release 3.0
 ;                   BLOCKS.LSP is a module of QUICK COMMAND
;                        Copyright 1989, 90, 92 Dan Jincks
 ;
 ;
;              This is SHAREWARE, it is NOT Public Domain software.
 ;
 ;              This code or any part of this code may not be reproduced
 ;              in any publication without prior written permission.
 ;
 ;              Printed copy of this code or any part of this code may not
 ;              be distributed without prior written permission.
 ;
 ;              Printed copy may only be made for reference purposes by
 ;              the end user.
 ;
 ;
 ;                               Dan Jincks
 ;                             Box 155A HCR 77
 ;                           Annapolis, MO 63620
 ;
 ;
 ;
 ;   You are granted a limited license to use BLOCKS.LSP for a 30 day trial
 ;   period.  If you wish to continue using any or all of QUICK COMMAND after
 ;   the trial period, you must become a registered user.  As a registered
 ;   user, you may use QUICK COMMAND on 1 workstation or terminal.
 ;   Additional registrations must be bought for each additional workstation or
 ;   terminal.  To become a registered user, see QC3.DOC
 ;
 ;
 ;   You may send copies of QUICK COMMAND to friends and associates if you abide
 ;   by the following rules:
 ;
 ;   1. It may only be distributed in the original unmodified form.
 ;   2. All original files must be included.
 ;   3. No addition files may be added.
 ;   4. If other files will be on the same disk, QUICK COMMAND files must be in
 ;      a library format such as ".ARC" called "QUICKCMD", or else be put alone
 ;      in a subdirectory called "QUICKCMD".
 ;   5. You may not sell QUICK COMMAND or any part of it.
 ;   6. You are not allowed to charge more then $5 to cover the cost of copying
 ;      and distribution.
 ;   7. You may not distribute any hard copy of the contents of QUICK COMMAND.
 ;
 ;
 ;   These AutoLISP commands and functions are designed to save you time, and
 ;   saving time means saving money.  The registration fee is very modest
 ;   compared to the savings, and much less expensive then typical third party
 ;   AutoCAD software. Be sure to registar if you continue to use them.
 ;
 ;
 ;                                                               DAN
 ;
 ;
 ;
 ;
 ;        AutoCAD and AutoLISP are registered trade marks of Autodesk Inc.
 ;
 ;        ***************************************************************
 ;
 ; Begin BLOCKS.LSP
 ;
;  BLI function
 ;
(defun C:BLI (/ SCA SCB SCC SCD SCE SCF SCG)(terpri)
   (setvar "cmdecho" 0)
   (prompt "Define a block, then insert back into original place")(terpri)
   (prompt " ")(terpri)
   (setq SCA (strcase (getstring "Block name (or ?):  ")))(terpri)
   (setq SCF (strlen SCA))
   (setq SCD (tblsearch "block" SCA))
   (if (/= SCD nil)(progn
      (setq SCG (ssget "X" (list (cons 2 SCA))))
      (command "select" SCG)
      (prompt "Block  ")(princ SCA)(prompt "  already exists.")(terpri)
      (prompt " ")(terpri)(prompt "Redefine  ")(princ SCA)
      (initget "Yes No")
      (setq SCE (getkword "  ?  Y/N <No>  "))(command "")(terpri)
         (if (/= SCE "Yes")(setq SCA nil))))
   (if (= SCA "?")(progn
      (command "BLOCK" "?" )(setq SCA nil)))
   (if (and (/= SCF 0)(/= SCA nil))(progn
      (setq SCB (getpoint "Insertion base point: "))(terpri)
      (if SCB (setq SCC (ssget)))))
   (if(and SCA SCB SCC)(progn
      (if (/= SCD nil)
         (command "BLOCK" SCA "Yes" SCB SCC "" "INSERT" SCA SCB "" "" "")
         (command "BLOCK" SCA SCB SCC "" "INSERT" SCA SCB "" "" ""))
   ))(setvar "cmdecho" 1)(princ)
)
 ;
;  WBR function
 ;
(defun C:WBR(/ SCA SCB SCC SCD )(terpri)
   (setvar "cmdecho" 0)
   (prompt "Write to a file, then Restore the drawing.")
   (terpri)
   (setq SCB (strcase (getstring "File name:  ")))(terpri)
   (setq SCC (findfile (strcat SCB ".DWG")))
   (setq SCD (tblsearch "block" SCB))
   (if (= SCD nil)(progn
      (if (= SCC nil)(progn
         (setq SCC (getpoint "Insertion point: "))
         (if SCC (setq SCA (ssget)))
         (if SCA (command "WBLOCK" SCB "" SCC SCA "" "OOPS")))
         (prompt "File already exists - Use WBLOCK command.")
      ))
     (prompt "Block name already used - Use WBLOCK command.")
  )(setvar "cmdecho" 1)(princ)
)
 ;
;  WBI function
 ;
(defun C:WBI(/ SCA SCB SCC SCD )(terpri)
   (setvar "cmdecho" 0)
   (prompt "Write a Block to a file, then Insert back into original place")
   (terpri)
   (setq SCB (strcase (getstring "File name:  ")))(terpri)
   (setq SCC (findfile (strcat SCB ".DWG")))
   (setq SCD (tblsearch "block" SCB))
   (if (= SCD nil)(progn
      (if (= SCC nil)(progn
         (setq SCC (getpoint "Insertion point: "))
         (if SCC (setq SCA (ssget)))
         (if SCA (command "WBLOCK" SCB "" SCC SCA "" "INSERT" SCB SCC "" "" "")))
         (prompt "File already exists - Use WBLOCK command.")
      ))
     (prompt "Block already exists - Use WBLOCK command.")
  )(setvar "cmdecho" 1)(princ)
)
 ;
;  BLH function
 ;
(defun C:BLH (/ SCA SCD SCF SCG)
   (setvar "cmdecho" 0)
   (prompt "Highlight all visable occurrences of a Block")(terpri)
   (prompt " ")(terpri)
   (setq SCA (strcase (getstring "Block name:  ")))
   (setq SCF (strlen SCA))
   (setq SCD (tblsearch "block" SCA))(terpri)
   (if (/= SCF 0)(progn
      (if (/= SCD nil)
         (progn
            (graphscr)
            (setq SCG (ssget "X" (list (cons 2 SCA))))
            (if (/= SCG nil)(progn (prompt "Press ENTER")
                  (command "select" SCG pause))
               (prompt "Block is nested or not on screen.")
            )
         )
         (progn (prompt "Block named  ")(princ SCA)(prompt "  is not listed.")
            (prompt "    Press ENTER") (command pause "BLOCK" "?")
         )
      )
   ))
   (setvar "cmdecho" 1)(princ)
)
 ;
 ;   End BLOCKS.LSP